perm filename 60X[NEW,LCS] blob
sn#165253 filedate 1975-06-21 generic text, type T, neo UTF8
00100 60 J2=R2
00200
00300
00400
00500
00600
00700 RSTJ2=RSTFAC(J2)
00800
00900
01000
01100
01200
01900 IF(JA.NE.2)GO TO 163
02000
02100
02200
02300
02400
02500 IF(R9.EQ.0)GO TO 163
02600
02700
02800
02900
03000
03100 K=ITEM
03200
03300
03400
03500
03600
03700 C ITEM+1 IS CURRENT ITEM IN QUICK RUN-THROUGHS.
04100
04200
04300 IF(X22.NE.0)K=X22-1
04400
04500
04600
04700
04800
04900 RD=1.75*RSTJ2
05000
05100
05200
05300
05400
05500 L=PWDS(K+2)
05600
05700
05800
05900
06000
06100 IF(RN(L+1).NE.4)GO TO 164
06200
06700 C GO ON IF NEXT ISN'T BAR LINE (CODE 4. COULD FIND OTHER LINES!!)
06800
06900
07000
07100
07200
07300 RB=RN(L+3)
07400
07500
07600
07700
07800
07900 L=PWDS(K)
08000
08500 C CHECK PREV. AND NEXT ITEM. IF NOT BAR, DON'T TRY TO CENTER!
08600
08700
08800
08900
09000
09100 IF(RN(L+1).NE.4)GO TO 164
09200
09300
09400
09500
09600
09700 RA=RN(L+3)
09800
09900
10000
10100
10200
10300 R3=RA+(RB-RA)/2-1.75*RSTJ2
10400
10500
10600
10700
10800
10900 164 IF(PLT.EQ.0)GO TO 160
11000
11100
11200
11300
11400
11500 RN(IFIX(PWDS(K+1))+3)=R3
11600
12100 C ******* A DANGEROUS PLACE. KEEP TRACK OF THIS
12200
12300
12400
12500
12600
12700 GO TO 5541
12800
12900
13000
13100
13200
13300
13400
13500
13600
13700
13800
13900 163 IF(JA.EQ.16)GO TO 63
14000
14100
14200
14300
14400
14500 IF(PLT.NE.0)GO TO 5541
14600
14700
14800
14900
15000
15100 IF(JA.NE.8)GO TO 70
15200
15300
15400
15500
15600
15700 IF(R9.NE.1)GO TO 70
15800
15900
16000
16100
16200
16300 R9=RN(MEDIT+9)
16400
16500
16600
16700
16800
16900 IF(R9.NE.' ')TYPE 427,R9
17000
17100
17200
17300
17400
17500 TYPE 21
17600
17700
17800
17900
18000
18100 ACCEPT FA5,R9
18200
18300
18400
18500
18600
18700 IF(R9.EQ.LY(1))R9=0
18800
19300 C WHEN P9=1 ASKS FOR ID NAME FOR THE STAFF (FOR PART EXTRACTOR)
19400
19500
19600
19700
19800
19900 70 IF(JA.NE.11)GO TO 160
20000
20500 C ↑↑↑↑ WAS - TO 63
20600
20700
20800
20900
21000
21100 IF(J10.NE.1)GO TO 62
21200
21300
21400
21500
21600
21700 TYPE 21
21800
21900
22000
22100
22200
22300 ACCEPT FA5,NJR
22400
22500
22600
22700
22800
22900 C P10←1 GETS NAME OF BASIC DRAW FILE, PUTS IT IN P10 (NJR)
23000
23100
23200
23300
23400
23500 LASTNM=NJR
23600
23700
23800
23900
24000
24100 62 IF(NJR.EQ.0)NJR=LASTNM
24200
24700 C IF NO NAME ASKED FOR, IT TAKES LAST NAME GIVEN.(SOLVES SORT PROB?)
24800
24900
25000
25100
25200
25300 GO TO 160
25400
25500
25600
25700
25800
33500
33600
33700 L=ITEM
33800
33900
34000
34100
34200
34300 IF(X22.NE.0)L=X22-1
34400
34500
34600
34700
34800
34900 IF(J10.EQ.1)GO TO 263
35000
35100
35200
35300
35400
35500 C NEXT FOR CENTERING OF TEXT. P10>1
35600
35700
35800
35900
36000
36100 RB=0
36200
36300
36400
36500
36600
36700 X=PWDS(L+1)
36800
36900
37000
37100
37200
37300 363 L=L+1
37400
37500
37600
37700
37800
37900 K=PWDS(L)
38000
38100
38200
38300
38400
38500 RB=RB+RN(K+9)
38600
38700
38800
38900
39000
39100 C ADD SPACE NEEDED
39200
39300
39400
39500
39600
39700 K=PWDS(L+1)
39800
39900
40000
40100
40200
40300 IF(RN(K+1).NE.16)GO TO 463
40400
40500
40600
40700
40800
40900 IF(RN(K).EQ.8)GO TO 363
41000
41100
41200
41300
41400
41500 C GO BACK IF MORE LETTERS TO COME
41600
41700
41800
41900
42000
42100 463 R3=R10-(RB-3.4)*R5*RSTJ2/2.
42200
42300
42400
42500
42600
42700 C +3.4 IS TO COMPENSATE FOR STARTING POS. BEING IN CENTER OF LET.
42800
42900
43000
43100
43200
43300 R10=0
43400
43500
43600
43700
43800
43900 IF(RN(X).EQ.8)RN(X+10)=0
44000
44100
44200
44300
44400
44500 RN(X+3)=R3
44600
44700
44800
44900
45000
45100 C THESE ARE NEEDED FOR ITEMS CENTERED DIRECTLY FROM 'WORDS'
45200
45300
45400
45500
45600
45700 GO TO 162
45800
45900
46000
46100
46200
46300 263 K=PWDS(L)
46400
46500
46600
46700
46800
46900 R3=R5*RSTJ2*RN(K+9)+RN(K+3)
47000
47100
47200
47300
47400
47500 RN(IFIX(PWDS(L+1))+3)=R3
47600
47700
47800
47900
48000
48100 C PUTS POS. BACK INTO RN ARRAY EVERY TIME.
48200
48300
48400
48500
48600
48700 C PUTS 13TH(+) LETTER IN RIGHT POS.
48800
48900
49000
49100
49200
49300 162 IF(PLT.NE.0)GO TO 5541
49400
49500
49600
49700
49800
49900 CX160 IF(EDX.NE.0)GO TO 162
50000
50100
50200
50300
50400
50500 CP IF(I1.EQ.IP)GO TO 5541
50600
50700
50800
50900
51000
51100 CX162 RJ3=R3
51200
51300
51400
51500
51600
51700 160 RJ3=R3
51800
51900
52000
52100
52200
52300 JJA=JA
52400
52500
52600
52700
52800
52900 IF(R8.NE.0)GO TO 161
53000
53100
53200
53300
53400
53500 IF(JA.EQ.1)R8=999.
53600
53700
53800
53900
54000
54100 C 999=0 FOR STEM EXTENSIONS.
54200
54300
54400
54500
54600
54700 CL161 CNT=1
54800
54900
55000
55100
55200
55300 CL DO 5543 K=1,9
55400
55500
55600
55700
55800
55900 C 10/6/73 ABOVE WAS ,11
56000
56100
56200
56300
56400
56500 CL RA=RJQ(K)
56600
56700
56800
56900
57000
57100 CL IF(RA.NE.0)CNT=K
57200
57300
57400
57500
57600
57700 CL5543 RJJ(K)=RA
57800
57900
58000
58100
58200
58300 C USES ONLY 10 PARAMETERS BEYOND JA, J2
58400
58500
58600
58700
58800
58900 161 CALL MSSLUP
59000
59100
59200
59300
59400
59500 CP2554 IF(PLT.NE.0)GO TO 5541
59600
59700
59800
59900
60000
60100 IF(JA.EQ.6)CALL HOMER
60200
60300
60400
60500
60600
60700 IF(JA.NE.13)GO TO 1261
60800
60900
61000
61100
61200
61300 IF(J6.NE.0)R13=-1
61400
61500
61600
61700
61800
61900
62000
62100
62200
62300
62400
62500 1261 IF(R13.EQ.0)GO TO 261
62600
62700
62800
62900
63000
63100 CALL HOMER
63200
63300
63400
63500
63600
63700 IF(JA.EQ.10)R3=R3+RSTJ2
63800
63900
64000
64100
64200
64300 C ABOVE HELPS CENTER NUMBERS UNDER NOTES(BECAUSE R3 IS AT CENTR OF NUM)
64400
64500
64600
64700
64800
64900 C IF P13≠0 ANY ITEM WILL LINE UP WITH ANY OTHER ITEM. P13 IS RESET=0
65000
65100
65200
65300
65400
65500 C **** FOR '0' EDITS ******
65600
65700
65800
65900
66000
66100 CL261 RN(I)=CNT
66200
66300
66400
66500
66600
66700 CL RN(I+1)=JA
66800
66900
67000
67100
67200
67300 CL I=I+2
67400
67500
67600
67700
67800
67900 CL RN(I)=R2
68000
68100
68200
68300
68400
68500 CL IF(RD.NE.0)RN(I)=RD
68600
68700
68800
68900
69000
69100 C TO SAVE NOTE NUMBS IN P2.
69200
69300
69400
69500
69600
69700 CL DO 4554 K=1,CNT
69800
69900
70000
70100
70200
70300 CL4554 RN(I+K)=RJQ(K)
70400
70500
70600
70700
70800
70900 CL3554 I=CNT+1+I
71000
71100
71200
71300
71400
71500 261 CALL LUP2
71600
71700
71800
71900
72000